home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / tbbyte.arc / PILOT2.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-08-14  |  4.8 KB  |  204 lines
  1. {PASCAL VERSION OF WADUZITDO}
  2. program waduzitdo;
  3.  
  4. const
  5.   pz=5000;
  6.   bs=127;
  7.   eol=10;
  8.   strlen=80;
  9.  
  10. type
  11.   str=string[strlen];
  12.  
  13. var
  14.   loc,lst,i,e,c : integer;
  15.   lchr,flg,cbuf,ch,curs,cbs,ceol : char;
  16.   s : str;
  17.   flag, run, done: boolean;
  18.   prog : array[1..pz] of char;
  19.  
  20. procedure chin;
  21.     begin
  22.       if flag then
  23.         begin
  24.           e := 1;
  25.           write (curs);
  26.           read(s);
  27.           flag := false
  28.         end;
  29.       if e > length(s) then
  30.          begin
  31.            e := 1;
  32.            writeln;
  33.            write (curs);
  34.            read (s);
  35.            cbuf := chr(eol)
  36.          end
  37.       else
  38.          begin
  39.            c := ord(s[e]);
  40.            if c = $1b then
  41.               begin
  42.                 done := true;
  43.                 c := $20
  44.               end;
  45.            ch := chr(c);
  46.            cbuf := ch;
  47.            e := e + 1
  48.          end;
  49. end;
  50.  
  51. procedure chout;
  52.     begin
  53.       if cbuf = chr(eol) then
  54.         writeln
  55.       else
  56.         write (cbuf);
  57.     end;
  58.  
  59. procedure newline;
  60.     begin
  61.       writeln;
  62.     end;
  63.  
  64. procedure list;
  65.   var i: integer;
  66.     begin
  67.       i := 0;
  68.       loc := loc - 1;
  69.       repeat
  70.         cbuf := prog [loc];
  71.         loc := loc + 1;
  72.         i := i + 1;
  73.         chout
  74.       until (i>64) or (cbuf=ceol);
  75.       newline
  76.     end;
  77.  
  78. procedure listall;
  79.     var j : integer;
  80.     begin
  81.       j := 0;
  82.       loc := 1;
  83.       repeat
  84.         list;
  85.         j := j + 1
  86.       until (prog[loc+1] = 'S') or (j = 10);
  87.       newline
  88.     end;
  89.  
  90. procedure execute;
  91.     begin
  92.       loc :=1;
  93.       curs := '#';
  94.       repeat
  95.         cbuf := prog[loc];
  96.         if cbuf < '*' then
  97.            cbuf := '*';
  98.         if not (cbuf in ['*','Y','N','A','M','J','T','S']) then
  99.            list
  100.         else
  101.            case cbuf of
  102.            '*': loc := loc+1;
  103.            'Y': if cbuf = flg then
  104.                          loc := loc + 1
  105.                       else
  106.                          repeat
  107.                            cbuf := prog[loc];
  108.                            write (cbuf);
  109.                            loc := loc + 1
  110.                          until cbuf = ceol;
  111.  
  112.            'N': if cbuf = flg then
  113.                          loc := loc + 1
  114.                       else
  115.                          repeat
  116.                            cbuf := prog[loc];
  117.                            write (cbuf);
  118.                            loc := loc + 1
  119.                          until cbuf = ceol;
  120.            'A' : begin
  121.                    lst := loc;
  122.                    chin;
  123.                    lchr := cbuf;
  124.                    newline;
  125.                    loc := loc + 2
  126.                  end;
  127.            'M' : begin
  128.                    if lchr = prog[loc+2] then
  129.                       flg := 'Y'
  130.                    else
  131.                       flg := 'N';
  132.                    loc := loc + 3
  133.                  end;
  134.            'J' : if prog[loc+2] = '0' then
  135.                     loc := lst
  136.                  else
  137.                     begin
  138.                       i := ord(prog[loc+2])-48;
  139.                       repeat
  140.                         loc := loc + 1;
  141.                         if prog[loc] = '*' then
  142.                            i := i - 1;
  143.                       until i = 0
  144.                     end;
  145.            'T' : begin
  146.                    loc := loc + 2;
  147.                    list
  148.                  end;
  149.            'S' : begin
  150.                    done := true;
  151.                    loc := 1
  152.                  end
  153.          end
  154.      until done
  155.   end;
  156.  
  157. begin
  158.     cbs := chr(bs);
  159.     ceol := chr(eol);
  160.     cbuf := '\';
  161.     flag := true;
  162.     run := true;
  163.     while run do
  164.       begin
  165.         curs := '*';
  166.         if cbuf = '\' then
  167.            loc := 1
  168.         else if cbuf = cbs then
  169.                 loc := loc - 1
  170.         else if cbuf = '/' then
  171.                 list
  172.         else if cbuf = '=' then
  173.                 listall
  174.         else if cbuf = '$' then
  175.                 begin
  176.                   done := false;
  177.                   execute
  178.                 end
  179.         else if cbuf = '!' then
  180.                 run := false
  181.         else if cbuf = '%' then
  182.                 begin
  183.                   i := 0;
  184.                   while (i<64) and (prog[loc] <> ceol) do
  185.                     begin
  186.                       prog[loc] := chr(0);
  187.                       loc := loc + 1
  188.                     end;
  189.                   prog[loc] := ceol;
  190.                   loc := loc + 1
  191.                 end
  192.         else begin
  193.                prog[loc] := cbuf;
  194.                loc := loc + 1
  195.              end;
  196.         if run then
  197.           begin
  198.             curs := '*';
  199.             chin
  200.           end
  201.      end
  202.     end.
  203.  
  204.